home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #08 (Apr86-May86) / Forth April 86 / Spooler
Text File  |  1986-02-06  |  2KB  |  68 lines
  1. ( background printer task )
  2. only mac also i/o also forth
  3.  
  4. : wkg_spool working" spool.####" ;
  5. : cre_spool  create" spool.####" ;
  6. : use_spool   using" spool.####" ;
  7.  
  8.   variable filecount
  9.   variable printlist 400 vallot
  10.   variable print.ptr
  11.   190 user active.spool 
  12.  
  13. : file#  filecount  @ ;
  14. : print# print.ptr  @ 4 - @ ;
  15. : incr.file  file#  1+ filecount  ! ;
  16. : incr.print print.ptr @ 4 + print.ptr ! ;
  17. : decr.print print.ptr @ 4 - print.ptr ! ;
  18. : reset.file  1 filecount  ! ;
  19. : reset.print printlist print.ptr ! ;
  20. : add.spool ( n - ) 
  21.     printlist print.ptr @  do i 4 - @ i ! -4 +loop  incr.print 
  22.     printlist ! ;
  23. : list.busy print.ptr @ printlist <> ; 
  24.  
  25. 11 constant ##offset ( offset from beginning of file routine to file name )
  26.  
  27. : wkg_spool# ( n - ) <# # # # # #>  ( four digits )
  28.   ['] wkg_spool ##offset + swap  cmove ( change file name )
  29.     wkg_spool ;
  30.  
  31. : cre_spool# ( n - ) <# # # # # #> 
  32.   ['] cre_spool ##offset + swap  cmove  cre_spool ;
  33.  
  34. : use_spool# ( n - ) <# # # # # #> 
  35.   ['] use_spool ##offset + swap  cmove  use_spool ;
  36.  
  37. : new_spool 
  38.     incr.file file# cre_spool# file# wkg_spool#  file# active.spool !
  39.     ." Your spool file is spool." file# . cr
  40.     file output 12 emit ." SPOOL FILE # " file# . cr
  41.     console file + output 
  42. ;
  43.  
  44. : close_spool console output close-file active.spool @ add.spool ;
  45.  
  46. : print_file 0 begin dup virtual c@ dup while emit 1+ repeat 2drop ;
  47.  
  48. : print_spool 
  49.     list.busy if
  50.         print# decr.print use_spool#  disk 4 + w@
  51.         not if print_file close-file  else 10 call sysbeep then 
  52.     then ;
  53.         
  54. 400 1000 background spool_task
  55. spool_task build
  56. hex
  57. : spool activate 
  58.     1cc0a mode2  comm2 output
  59.     begin print_spool pause again
  60. ;
  61. decimal
  62. reset.file reset.print
  63. spool_task spool
  64.  
  65.  
  66.            
  67.  
  68.